home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / SystemCode / calc.tcl < prev    next >
Text File  |  1996-08-15  |  5KB  |  210 lines
  1.  
  2. ##########################################################################
  3. #                                                                         #
  4. #    Use    at your    own    risk. This is just a quick-and-dirty RPN stack         #
  5. #    calculator,    works on both decimal (signed and unsigned), hex         #
  6. #     integers, and floating point. I put it                                 #
  7. #    together for my    own    use, not yours,    but    feel free to use it    as         #
  8. #    long as    you    don't complain about what it doesn't do. Improvements,     #
  9. #    of course, are welcome.                                                 #
  10. #                                                                         #
  11. #    Operations:                                                             #
  12. #        +,-,*,/,|,&,%    Top    of stack is    'y', next is 'x'. Does x OP    y.     #
  13. #        ~                bitwise NOT                                         #
  14. #        ^                x eor y                                             #
  15. #        <                x << y                                             #
  16. #        >                x >> y                                             #
  17. #        c                change y's sign                                     #
  18. #        q                dup    y                                             #
  19. #        i                swap x and y                                     #
  20. #        m                switch decimal/hex modes                         #
  21. #        x                show current mode                                 #
  22. #        h,?                help                                             #
  23. #        <delete>        pop    stack                                         #
  24. #        <space>            enter number                                     #
  25. #                                                                         #
  26. #    The mode indicator indicates whether hex or dec is active.              #
  27. #    All calculations performed in signed decimal.                         #
  28. #                                                                         #
  29. ##########################################################################
  30.  
  31.  
  32. proc calculator {} {
  33.     global tileLeft tileTop
  34.     if {[set ind [lsearch -exact [winNames] {* Calc *}]] >= 0} {
  35.         bringToFront {* Calc *}
  36.         return
  37.     }
  38.     new -g $tileLeft $tileTop 200 200 -n {* Calc *}
  39.     global winModes
  40.     set name [lindex [winNames] 0]
  41.     changeMode [set winModes($name) Calc]
  42.     catch {setWinInfo -w $name shell 1}
  43. }
  44.  
  45.  
  46. lappend modes Calc
  47. set modes [lsort $modes]
  48.  
  49. ascii 0x2b "binop +"    Calc
  50. ascii 0x2d "binop -"    Calc
  51. ascii 0x2a "binop *"    Calc
  52. ascii 0x2f "binop /"    Calc
  53. ascii 0x7c "binop |"    Calc
  54. ascii 0x5e "binop ^"    Calc
  55. ascii 0x26 "binop &"    Calc
  56. ascii 0x25 "binop %"    Calc
  57. ascii 0x3e "binop >>"    Calc
  58. ascii 0x3c "binop <<"    Calc
  59. ascii 0x7e "unaryop ~"     Calc
  60. ascii 0x63 "unaryop -"    Calc
  61. ascii 0x3f "editMark ¥"$HOME:Help:Manual¥" Calculator -r" Calc
  62. ascii 0x68 "editMark ¥"$HOME:Help:Manual¥" Calculator -r" Calc
  63. ascii 0x71 calcDup        Calc
  64. ascii 0x69 calcEx        Calc
  65. ascii 0x6d changeCalcMode    Calc
  66. ascii 0x78 "calcShow"    Calc
  67. ascii 0x20 calcEnter    Calc
  68. ascii 0x08 calcDel        Calc
  69.  
  70. set calcMode 3
  71.  
  72. proc changeCalcMode {} {
  73.     global calcMode
  74.     
  75.     goto [maxPos]
  76.     if {[getPos]} {
  77.         if {[lookAt [expr [getPos] - 1]] != "¥r"} calcEnter
  78.         set nums {}
  79.         set t ""
  80.         foreach n [split [getText 0 [expr [maxPos] - 1]] "¥r"] {
  81.             lappend nums [calcGet $n]
  82.         }
  83.         set calcMode [expr ($calcMode + 1) % 4]
  84.         foreach n $nums {
  85.             append t "[calcPut $n]¥r"
  86.         }
  87.         replaceText 0 [maxPos] $t
  88.     } else {
  89.         set calcMode [expr ($calcMode + 1) % 4]
  90.     }
  91.     switch "$calcMode" {
  92.         0     {message "Signed decimal" }
  93.         1     {message "Unsigned decimal"}
  94.         2     {message "Unsigned hexadecimal"}
  95.         3     {message "Floating Point"}
  96.     }
  97. }
  98.  
  99.  
  100. proc calcShow {} {
  101.     global calcMode
  102.     switch "$calcMode" {
  103.         0     {message "Signed decimal" }
  104.         1     {message "Unsigned decimal"}
  105.         2     {message "Unsigned hexadecimal"}
  106.         3     {message "Floating Point"}
  107.     }
  108. }
  109.  
  110.  
  111. proc calcGet {in} {
  112.     global calcMode
  113.  
  114.     switch "$calcMode" {
  115.         0    {scan $in "%d" num; return $num}
  116.         1    {scan $in "%u" num; return $num}
  117.         2    {scan $in "%x" num; return $num}
  118.         3    {scan $in "%f" num; return $num}
  119.     }
  120.     error "Bad hex num '$in'"
  121. }
  122.  
  123.  
  124. proc calcPut {in} {
  125.     global calcMode
  126.  
  127.     if {$calcMode != 3} {
  128.         regexp {[0-9-]+} $in in
  129.     }
  130.     switch $calcMode {
  131.         0         {return [format "%10d" $in]}
  132.         1         {return [format "%10u" $in]}
  133.         2         {return [format "%10x" $in]}
  134.         3         {return [format "%17.6f" $in]}
  135.     }
  136. }
  137.  
  138.         
  139. proc binop {op} {
  140.     global calcMode
  141.     goto [maxPos]
  142.     if {[lookAt [expr [getPos] - 1]] != "¥r"} calcEnter
  143.     set pos [lineStart [getPos]]
  144.     set st_y [lineStart [expr $pos - 1]]
  145.     set st_x [lineStart [expr $st_y - 1]]
  146.     if {$st_y == $st_x} { beep; return}
  147.     set res [eval expr [calcGet [getText $st_x $st_y]] $op [calcGet [getText $st_y $pos]]]
  148.     replaceText $st_x [maxPos] "[calcPut $res]¥r"
  149. }
  150.  
  151.  
  152. proc unaryop {op} {
  153.     goto [maxPos]
  154.     
  155.     set pos [getPos]
  156.     set last [lineStart [expr [getPos] - 1]]
  157.     replaceText $last $pos [expr "[calcPut $op[calcGet [getText $last $pos]]]"] "¥r"
  158. }
  159.  
  160.  
  161. proc calcEx {} {
  162.     goto [maxPos]
  163.     if {[lookAt [expr [getPos] - 1]] != "¥r"} calcEnter
  164.     set pos [lineStart [getPos]]
  165.     set st_y [lineStart [expr $pos - 1]]
  166.     set st_x [lineStart [expr $st_y - 1]]
  167.     if {$st_y == $st_x} { beep; return}
  168.     replaceText $st_x [maxPos] "[getText $st_y $pos][getText $st_x $st_y]"
  169. }
  170.  
  171.  
  172. proc calcEnter {} {
  173.     global calcMode
  174.     goto [maxPos]
  175.     switch "$calcMode" {
  176.         0     {set ex {[0-9-]+$}}
  177.         1     {set ex {[0-9]+$}}
  178.         2     {set ex {[0-9a-f]+$}}
  179.         3     {set ex {[0-9.-]+$}}
  180.     } 
  181.     if {[regexp $ex [getText [lineStart [getPos]] [getPos]] num]} {
  182.         set num [calcGet $num]
  183.         replaceText [lineStart [getPos]] [getPos] [calcPut $num] "¥r"
  184.     } else {
  185.         beep
  186.         beginningOfLine
  187.         killLine
  188.     }
  189. }
  190.  
  191. proc calcDel {} {
  192.     goto [maxPos]
  193.     if {[lookAt [expr [getPos] - 1]] == "¥r"} {
  194.         deleteText [lineStart [expr [getPos] - 1]] [getPos]
  195.     } else {
  196.         backSpace
  197.     }
  198. }
  199.  
  200. proc calcDup {} {
  201.     goto [maxPos]
  202.     if {[lookAt [expr [getPos] - 1]] != "¥r"} calcEnter
  203.     set to [lineStart [getPos]]
  204.     set from [lineStart [expr $to - 1]]
  205.     set t [getText $from $to]
  206.     insertText $t
  207. }
  208.  
  209.  
  210.